home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / kcl.lha / c / number.c < prev    next >
C/C++ Source or Header  |  1987-06-04  |  4KB  |  232 lines
  1. /*
  2. (c) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
  3. Copying of this file is authorized to users who have executed the true and
  4. proper "License Agreement for Kyoto Common LISP" with SIGLISP.
  5. */
  6.  
  7. /*
  8.     number.c
  9.     IMPLEMENTATION-DEPENDENT
  10.  
  11.     This file creates some implementation dependent constants.
  12. */
  13.  
  14. #include "include.h"
  15. #include "num_include.h"
  16.  
  17.  
  18. int
  19. fixint(x)
  20. object x;
  21. {
  22.     if (type_of(x) != t_fixnum)
  23.         FEerror("~S is not a fixnum.", 1, x);
  24.     return(fix(x));
  25. }
  26.  
  27. int
  28. fixnnint(x)
  29. object x;
  30. {
  31.     if (type_of(x) != t_fixnum || fix(x) < 0)
  32.         FEerror("~S is not a non-negative fixnum.", 1, x);
  33.     return(fix(x));
  34. }
  35.  
  36. object
  37. make_fixnum(i)
  38. int i;
  39. {
  40.     object x;
  41.  
  42.     if (-SMALL_FIXNUM_LIMIT <= i && i < SMALL_FIXNUM_LIMIT)
  43.         return(small_fixnum(i));
  44.     x = alloc_object(t_fixnum);
  45.     fix(x) = i;
  46.     return(x);
  47. }
  48.  
  49. object
  50. make_ratio(num, den)
  51. object num, den;
  52. {
  53.     object g, r, integer_divide1(), get_gcd();
  54.     vs_mark;
  55.  
  56.     if (number_zerop(num))
  57.         return(small_fixnum(0));
  58.     if (number_zerop(den))
  59.         FEerror("Zero denominator.", 0);
  60.     if (type_of(den) == t_fixnum && fix(den) == 1)
  61.         return(num);
  62.     if (number_minusp(den)) {
  63.         num = number_negate(num);
  64.         vs_push(num);
  65.         den = number_negate(den);
  66.         vs_push(den);
  67.     }
  68.     g = get_gcd(num, den);
  69.     vs_push(g);
  70.     num = integer_divide1(num, g);
  71.     vs_push(num);
  72.     den = integer_divide1(den, g);
  73.     vs_push(den);
  74.     if(type_of(den) == t_fixnum && fix(den) == 1) {
  75.         vs_reset;
  76.         return(num);
  77.     }
  78.     if(type_of(den) == t_fixnum && fix(den) == -1) {
  79.         num = number_negate(num);
  80.         vs_reset;
  81.         return(num);
  82.     }
  83.     r = alloc_object(t_ratio);
  84.     r->rat.rat_num = num;
  85.     r->rat.rat_den = den;
  86.     vs_reset;
  87.     return(r);
  88. }
  89.  
  90. object
  91. make_shortfloat(f)
  92. shortfloat f;
  93. {
  94.     object x;
  95.  
  96.     if (f == (shortfloat)0.0)
  97.         return(shortfloat_zero);
  98.     x = alloc_object(t_shortfloat);
  99.     sf(x) = f;
  100.     return(x);
  101. }
  102.  
  103. object
  104. make_longfloat(f)
  105. longfloat f;
  106. {
  107.     object x;
  108.  
  109.     if (f == (longfloat)0.0)
  110.         return(longfloat_zero);
  111.     x = alloc_object(t_longfloat);
  112.     lf(x) = f;
  113.     return(x);
  114. }
  115.  
  116. object
  117. make_complex(r, i)
  118. object r, i;
  119. {
  120.     object c;
  121.     vs_mark;
  122.  
  123.     switch (type_of(r)) {
  124.     case t_fixnum:
  125.     case t_bignum:
  126.     case t_ratio:
  127.         switch (type_of(i)) {
  128.         case t_fixnum:
  129.             if (fix(i) == 0)
  130.                 return(r);
  131.             break;
  132.         case t_shortfloat:
  133.             r = make_shortfloat((shortfloat)number_to_double(r));
  134.             vs_push(r);
  135.             break;
  136.         case t_longfloat:
  137.             r = make_longfloat(number_to_double(r));
  138.             vs_push(r);
  139.             break;
  140.         }
  141.         break;
  142.     case t_shortfloat:
  143.         switch (type_of(i)) {
  144.         case t_fixnum:
  145.         case t_bignum:
  146.         case t_ratio:
  147.             i = make_shortfloat((shortfloat)number_to_double(i));
  148.             vs_push(i);
  149.             break;
  150.         case t_longfloat:
  151.             r = make_longfloat((double)(sf(r)));
  152.             vs_push(r);
  153.             break;
  154.         }
  155.         break;
  156.     case t_longfloat:
  157.         switch (type_of(i)) {
  158.         case t_fixnum:
  159.         case t_bignum:
  160.         case t_ratio:
  161.         case t_shortfloat:
  162.             i = make_longfloat(number_to_double(i));
  163.             vs_push(i);
  164.             break;
  165.         }
  166.         break;
  167.     }            
  168.     c = alloc_object(t_complex);
  169.     c->cmp.cmp_real = r;
  170.     c->cmp.cmp_imag = i;
  171.     vs_reset;
  172.     return(c);
  173. }
  174.  
  175. double
  176. number_to_double(x)
  177. object x;
  178. {
  179.     switch(type_of(x)) {
  180.     case t_fixnum:
  181.         return((double)(fix(x)));
  182.  
  183.     case t_bignum:
  184.         return(big_to_double((struct bignum *)x));
  185.  
  186.     case t_ratio:
  187.         return(number_to_double(x->rat.rat_num) /
  188.                number_to_double(x->rat.rat_den));
  189.  
  190.     case t_shortfloat:
  191.         return((double)(sf(x)));
  192.  
  193.     case t_longfloat:
  194.         return(lf(x));
  195.  
  196.     default:
  197.         wrong_type_argument(TSor_rational_float, x);
  198.     }
  199. }
  200.  
  201. init_number()
  202. {
  203.     int i;
  204.     object x;
  205.  
  206.     for (i = -SMALL_FIXNUM_LIMIT;  i < SMALL_FIXNUM_LIMIT;  i++) {
  207.         small_fixnum_table[i + SMALL_FIXNUM_LIMIT].t
  208.         = (short)t_fixnum;
  209.         small_fixnum_table[i + SMALL_FIXNUM_LIMIT].FIXVAL = i;
  210.     }
  211.  
  212.     shortfloat_zero = alloc_object(t_shortfloat);
  213.     sf(shortfloat_zero) = (shortfloat)0.0;
  214.     longfloat_zero = alloc_object(t_longfloat);
  215.     lf(longfloat_zero) = (longfloat)0.0;
  216.     enter_mark_origin(&shortfloat_zero);
  217.     enter_mark_origin(&longfloat_zero);
  218.  
  219.       make_constant("MOST-POSITIVE-FIXNUM",
  220.               make_fixnum(MOST_POSITIVE_FIX));
  221.     make_constant("MOST-NEGATIVE-FIXNUM",
  222.               make_fixnum(MOST_NEGATIVE_FIX));
  223.  
  224.     init_num_pred();
  225.     init_num_comp();
  226.     init_num_arith();
  227.     init_num_co();
  228.     init_num_log();
  229.     init_num_sfun();
  230.     init_num_rand();
  231. }
  232.